home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / vb / scbar.exe / SCRLFUNC.BAS < prev   
Encoding:
BASIC Source File  |  1993-01-05  |  12.2 KB  |  310 lines
  1. Option Explicit
  2.  
  3. '**********************************************************
  4. '   1993 -  Gary Garrison
  5. '           Software Assist Corporation
  6. '**********************************************************
  7.  
  8. Type Scroll_Bar_Attributes
  9. hWnd                As Integer      ' Handle of scrollbar
  10. InUse               As Integer      ' Flag for table entry
  11. InternalChange      As Integer      ' Internal change flag
  12. LastTrueValue       As Long         ' Last true value
  13. LastValue           As Integer      ' Last value of scroll bar
  14. Counter             As Long         ' Incrementing counter
  15. Factor              As Long         ' Value of each scroll value
  16. TrueMax             As Long         ' True maximum for scrollbar
  17. End Type
  18.  
  19. Dim SBA()           As Scroll_Bar_Attributes
  20. Dim SBA_Is_Dimed    As Integer      ' Flag indicating SBA dimed
  21. Dim iSBA            As Integer      ' Common index for SBA()
  22.  
  23. Function GetScrollBarChange (vsbObj As Control) As Long
  24. '****************************************************************
  25. '   Return the amount of the last change.
  26. '****************************************************************
  27.  
  28.     GetScrollBarChange = 0
  29.     iSBA = LocateScrollBar(vsbObj)
  30.     If iSBA = 0 Then Exit Function
  31.     If SBA(iSBA).Factor <> 1 Then
  32.         GetScrollBarChange = (vsbObj.Value - 1) * SBA(iSBA).Factor + SBA(iSBA).Counter - SBA(iSBA).LastTrueValue
  33.     Else
  34.         GetScrollBarChange = vsbObj.Value - SBA(iSBA).LastTrueValue
  35.     End If
  36. End Function
  37.  
  38. Function GetScrollBarValue (vsbObj As Control) As Long
  39. '****************************************************************
  40. '   Get the current, true value of a scroll bar.
  41. '****************************************************************
  42.  
  43.     GetScrollBarValue = 0
  44.     iSBA = LocateScrollBar(vsbObj)
  45.     If iSBA = 0 Then Exit Function
  46.     If SBA(iSBA).Factor <> 1 Then
  47.         GetScrollBarValue = (vsbObj.Value - 1) * SBA(iSBA).Factor + SBA(iSBA).Counter
  48.     Else
  49.         GetScrollBarValue = vsbObj.Value
  50.     End If
  51. End Function
  52.  
  53. Sub InitScrollBar (vsbObj As Control, MaxValue As Long)
  54. '****************************************************************
  55. '   Initialize a scrollbar.
  56. '****************************************************************
  57.  
  58.     Dim i           As Integer
  59.     Dim hWnd        As Integer
  60.  
  61. '****************************************************************
  62. '   Either find an existing entry for the scrollbar or create
  63. '   a new one.
  64. '****************************************************************
  65.     hWnd = vsbObj.hWnd
  66.     iSBA = LocateScrollBar(vsbObj)
  67.     If iSBA = 0 Then
  68.         If Not SBA_Is_Dimed Then
  69.             ReDim SBA(1 To 1) As Scroll_Bar_Attributes
  70.             SBA_Is_Dimed = True
  71.         End If
  72.         For i = 1 To UBound(SBA)
  73.             If SBA(i).hWnd = hWnd Then
  74.                 iSBA = i
  75.             ElseIf Not SBA(i).InUse And iSBA = 0 Then
  76.                 iSBA = i
  77.             End If
  78.         Next i
  79.     End If
  80.     If iSBA = 0 Then
  81.         ReDim Preserve SBA(i To UBound(SBA) + 1) As Scroll_Bar_Attributes
  82.         iSBA = UBound(SBA)
  83.     End If
  84.  
  85. '****************************************************************
  86. '   Set the initial values for the scrollbar.
  87. '****************************************************************
  88.     SBA(iSBA).InUse = True
  89.     SBA(iSBA).hWnd = hWnd
  90.     If vsbObj.Value <> 1 Then SBA(iSBA).InternalChange = True
  91.     SBA(iSBA).TrueMax = MaxValue
  92.     SBA(iSBA).LastValue = 1
  93.     SBA(iSBA).LastTrueValue = 1
  94.     SBA(iSBA).Counter = 1
  95.     
  96. '****************************************************************
  97. '   If the maximum value is greater than the range of a scrollbar
  98. '   .MAX, create a factor for the value of each scrollbar varlue.
  99. '   Otherwise, just treate it as a normal scrollbar.
  100. '****************************************************************
  101.     If MaxValue > 32767 Then
  102.         SBA(iSBA).Factor = Int(Sqr(MaxValue))
  103.         vsbObj.Max = SBA(iSBA).Factor + 3
  104.         vsbObj.Min = 0
  105.     Else
  106.         SBA(iSBA).Factor = 1
  107.         vsbObj.Max = MaxValue
  108.         vsbObj.Min = 1
  109.     End If
  110.  
  111.     vsbObj.Value = 1
  112. End Sub
  113.  
  114. Function LocateScrollBar (vsbObj As Control) As Integer
  115. '****************************************************************
  116. '   Locate a scrollbar in the SBA(). If it does not exist,
  117. '   return a 0.
  118. '****************************************************************
  119.  
  120.     Dim i As Integer
  121.     Dim hWnd As Integer
  122.     LocateScrollBar = 0
  123.     If Not SBA_Is_Dimed Then Exit Function
  124.     hWnd = vsbObj.hWnd
  125.     For i = 1 To UBound(SBA)
  126.         If hWnd = SBA(i).hWnd Then
  127.             LocateScrollBar = i
  128.             Exit Function
  129.         End If
  130.     Next i
  131. End Function
  132.  
  133. Function ScrollBarChangeEvent (vsbObj As Control) As Integer
  134. '****************************************************************
  135. '   Register a scrollbar change. Typically called by the
  136. '   scrollbar's _Change event.
  137. '
  138. '   If this is an externally (hitting scroll bar) generated
  139. '   event, True is returned. Otherwise, False is returned.
  140. '****************************************************************
  141.  
  142.     Dim ChgAmt As Integer
  143.     
  144.     ScrollBarChangeEvent = False
  145. '****************************************************************
  146. '   Locate the scrollbar in the SBA(). If not found, just exit.
  147. '****************************************************************
  148.     iSBA = LocateScrollBar(vsbObj)
  149.     If iSBA = 0 Then Exit Function
  150.  
  151. '****************************************************************
  152. '   If being called by an internal change to the value, just
  153. '   reset the InternalChange flag and exit.
  154. '****************************************************************
  155.     If SBA(iSBA).InternalChange Then SBA(iSBA).InternalChange = False: GoTo ScrollBarChangeEventExit
  156.     SBA(iSBA).InternalChange = True
  157.     ScrollBarChangeEvent = True
  158.     
  159. '****************************************************************
  160. '   If the factor is 1, this is treated like a normal scrollbar.
  161. '****************************************************************
  162.     If SBA(iSBA).Factor = 1 Then
  163.         SBA(iSBA).Counter = 1
  164.         SBA(iSBA).LastTrueValue = SBA(iSBA).LastValue
  165.         SBA(iSBA).LastValue = vsbObj.Value
  166.         SBA(iSBA).InternalChange = False
  167.         GoTo ScrollBarChangeEventExit
  168.     End If
  169.  
  170. '****************************************************************
  171. '   Record the LastTrueValue so the amount of change can be
  172. '   determined externally.
  173. '****************************************************************
  174.     SBA(iSBA).LastTrueValue = (SBA(iSBA).LastValue - 1) * SBA(iSBA).Factor + SBA(iSBA).Counter
  175.  
  176. '****************************************************************
  177. '   Determine the amount of change to the scrollbar and
  178. '   increment/decrement the counter.
  179. '****************************************************************
  180.     ChgAmt = -(SBA(iSBA).LastValue - vsbObj.Value)
  181.     SBA(iSBA).Counter = SBA(iSBA).Counter + ChgAmt
  182.  
  183. '****************************************************************
  184. '   Cannot let the value go to 0 (Min) or we could never reach
  185. '   scroll values less than 1 factor.
  186. '****************************************************************
  187.     If SBA(iSBA).Counter < 1 And vsbObj.Value < 1 Then
  188.         SBA(iSBA).Counter = 1
  189.         vsbObj.Value = 1
  190. '****************************************************************
  191. '   If the ChgAmt is equal to 1, we just have to see if counter
  192. '   has gone negative in which case it needs to be set to
  193. '   Factor-1, or if it has equaled the value of factor in which
  194. '   case it is set to 0, or if the counter is within range in
  195. '   which case we have to put the scrollbar's value back.
  196. '****************************************************************
  197.     ElseIf Abs(ChgAmt) = 1 Then
  198.         If SBA(iSBA).Counter < 0 Then
  199.             SBA(iSBA).Counter = SBA(iSBA).Factor - 1
  200.         ElseIf SBA(iSBA).Counter = SBA(iSBA).Factor Then
  201.             SBA(iSBA).Counter = 0
  202.         Else
  203.             vsbObj.Value = vsbObj.Value - ChgAmt
  204.         End If
  205.     Else
  206. '****************************************************************
  207. '   If the ChgAmt was not equal to 1, that means it was a major
  208. '   move. Just change the counter to 0 and let the scrollbar's
  209. '   value represent the true value.
  210. '****************************************************************
  211.         SBA(iSBA).Counter = 0
  212.     End If
  213.     
  214. '****************************************************************
  215. '   Record the value so that next time in we know what the
  216. '   change amount is. Turn off the internal change flag.
  217. '****************************************************************
  218.     SBA(iSBA).LastValue = vsbObj.Value
  219.     SBA(iSBA).InternalChange = False
  220.  
  221. '****************************************************************
  222. '   Routine exit point. Check to make sure we have not gone
  223. '   beyond the true maximum for the scrollbar. If so, set the
  224. '   values to the maximum.
  225. '****************************************************************
  226. ScrollBarChangeEventExit:
  227.     If (vsbObj.Value - 1) * SBA(iSBA).Factor + SBA(iSBA).Counter > SBA(iSBA).TrueMax Then
  228.         SBA(iSBA).InternalChange = True
  229.         SBA(iSBA).Counter = SBA(iSBA).TrueMax - ((SBA(iSBA).TrueMax \ SBA(iSBA).Factor) * SBA(iSBA).Factor)
  230.         vsbObj.Value = (SBA(iSBA).TrueMax \ SBA(iSBA).Factor) + 1
  231.         SBA(iSBA).LastValue = vsbObj.Value
  232.     End If
  233. End Function
  234.  
  235. Sub ScrollBarScrollEvent (vsbObj As Control)
  236. '****************************************************************
  237. '   Someone is tugging on the scrollbar's thumb.
  238. '****************************************************************
  239.  
  240.     iSBA = LocateScrollBar(vsbObj)
  241.     If iSBA = 0 Then Exit Sub
  242.  
  243. '****************************************************************
  244. '   If factor is 1, this is just a normal scrollbar.
  245. '****************************************************************
  246.     If SBA(iSBA).Factor = 1 Then Exit Sub
  247.     
  248. '****************************************************************
  249. '   Check to make sure don't go below 1 or above the maximum
  250. '   value for the scrollbar.
  251. '****************************************************************
  252.     If vsbObj.Value = 0 Then
  253.         SBA(iSBA).InternalChange = True
  254.         SBA(iSBA).Counter = 1
  255.         vsbObj.Value = 1
  256.     ElseIf vsbObj.Value = vsbObj.Max Then
  257.         SBA(iSBA).Counter = SBA(iSBA).TrueMax - ((vsbObj.Max - 2) * SBA(iSBA).Factor)
  258.     End If
  259. End Sub
  260.  
  261. Sub SetScrollBarValue (vsbObj As Control, newVal As Long)
  262. '****************************************************************
  263. '   Set the current, true value of a scroll bar.
  264. '****************************************************************
  265.     Dim sbVal As Long
  266.  
  267.     iSBA = LocateScrollBar(vsbObj)
  268.     If iSBA = 0 Then Exit Sub
  269.     
  270. '****************************************************************
  271. '   Make sure we are not going outside the valid range.
  272. '****************************************************************
  273.     If newVal < 1 Or newVal > SBA(iSBA).TrueMax Then Exit Sub
  274.  
  275.     SBA(iSBA).LastTrueValue = (vsbObj.Value - 1) * SBA(iSBA).Factor + SBA(iSBA).Counter
  276. '****************************************************************
  277. '   If the factor is 1, just set the value.
  278. '****************************************************************
  279.     If SBA(iSBA).Factor = 1 Then
  280.         sbVal = newVal
  281.     Else
  282.         sbVal = (newVal \ SBA(iSBA).Factor) + 1
  283.         SBA(iSBA).Counter = newVal - ((sbVal - 1) * SBA(iSBA).Factor)
  284.     End If
  285.  
  286. '****************************************************************
  287. '   If sbVal=scrollbar.Value, don't set InternalChange flag
  288. '   since setting the value would not cause a change.
  289. '****************************************************************
  290.     SBA(iSBA).LastValue = sbVal
  291.     If sbVal <> vsbObj.Value Then
  292.         SBA(iSBA).InternalChange = True
  293.         vsbObj.Value = sbVal
  294.     End If
  295. End Sub
  296.  
  297. Sub TermScrollBar (vsbObj As Control)
  298. '****************************************************************
  299. '   Teminate control of a scroll bar. This is not necessary at
  300. '   the end of the application. It's just here to be neat.
  301. '****************************************************************
  302.  
  303.     iSBA = LocateScrollBar(vsbObj)
  304.     If iSBA = 0 Then Exit Sub
  305.  
  306.     SBA(iSBA).InUse = False
  307.     SBA(iSBA).hWnd = 0
  308. End Sub
  309.  
  310.